perm filename PRINTC[901,BGB] blob
sn#129615 filedate 1974-11-12 generic text, type T, neo UTF8
(DEFPROP WWW
(NIL DX
DY
YMAXDY
KIND
PAGE
ORG
PEN
YMIN
YMAX
XMAX
SA
BPORG
FA
L
N
CHARMNL
EPL
IPL
OPL
MPL
INL
ONL
ENL
CC
C
SS
S
LS
Z
PPP2
PPP1
MIDPSIZ
CHARS
LLX
LEVEL
PSORG
NNN
P
MIDPR
LSPR
PRCHAR
PRCHAR2
CAF
DXDY
YBULGE
SOF
IMAGE
PFEY
FEYNMAN
OVERLAP
EQVAL
PHUNT
SETLEVEL
OUTPART
TAGEL
TORG
TORG2
ARROW
FERMI1
FERMI2
FERMI3
JIGJAG
NSET
TFSET
NILVAL
FUSE
IOBOTH
DELETE
INSERT
UNIQUE
UNBUCK
SUBSET
INTERSECTION
PEN
ORG
SIZORG
SIZ
KING
GETNEAR
OUTNODE
XPLY
ALIKE
SETN
XSET
YSET
YSET2
OAOOP
MOVE
YMINAX
YMISS
YMAX
XMAX
YMIN
F1
F2
VADD
VSUB
VSUBSIZ
LXY
SLOPE
MIDPOINT
METRIC
SQUARE
INCREM
CARLAST
ALSH
ADJUST
ROTATE
ROOT
NEWTON
TESTS
TP1
TP2
TP3
TP4
TP5
TP6
TP7
TP8
TP9
TP10
TP11
TP12
TP13
TP14
TP15
TP16
TP17
TP18
TP19
TP20
TP20
TP22
OFF)
VALUE)
(DEFPROP DX
T
SPECIAL)
(DEFPROP DY
T
SPECIAL)
(DEFPROP YMAXDY
T
SPECIAL)
(DEFPROP KIND
T
SPECIAL)
(DEFPROP PAGE
T
SPECIAL)
(DEFPROP ORG
(NIL 1400 . -300)
VALUE)
(DEFPROP ORG
T
SPECIAL)
(DEFPROP PEN
(NIL . T)
VALUE)
(DEFPROP PEN
T
SPECIAL)
(DEFPROP YMIN
(NIL . -1)
VALUE)
(DEFPROP YMIN
T
SPECIAL)
(DEFPROP YMAX
(NIL . 0)
VALUE)
(DEFPROP YMAX
T
SPECIAL)
(DEFPROP XMAX
(NIL . 4)
VALUE)
(DEFPROP XMAX
T
SPECIAL)
(DEFPROP SA
T
SPECIAL)
(DEFPROP BPORG
(NIL . 7440)
VALUE)
(DEFPROP BPORG
T
SPECIAL)
(DEFPROP FA
T
SPECIAL)
(DEFPROP L
T
SPECIAL)
(DEFPROP N
T
SPECIAL)
(DEFPROP EPL
T
SPECIAL)
(DEFPROP IPL
T
SPECIAL)
(DEFPROP OPL
T
SPECIAL)
(DEFPROP MPL
T
SPECIAL)
(DEFPROP INL
T
SPECIAL)
(DEFPROP ONL
T
SPECIAL)
(DEFPROP ENL
T
SPECIAL)
(DEFPROP CC
T
SPECIAL)
(DEFPROP C
T
SPECIAL)
(DEFPROP SS
T
SPECIAL)
(DEFPROP S
T
SPECIAL)
(DEFPROP LS
T
SPECIAL)
(DEFPROP Z
T
SPECIAL)
(DEFPROP PPP2
T
SPECIAL)
(DEFPROP LLX
T
SPECIAL)
(DEFPROP LEVEL
T
SPECIAL)
(DEFPROP PSORG
T
SPECIAL)
(DEFPROP NNN
T
SPECIAL)
(DEFPROP P
T
SPECIAL)
(DEFPROP MIDPR
(LAMBDA(A C)
(PROG (B X Y)
(SETQ B (MIDPOINT A C))
(COND
((AND (GREATERP 0.5 (TIMES DX (ABS (DIFFERENCE (CAR A) (CAR C)))))
(GREATERP 0.5 (TIMES DY (ABS (DIFFERENCE (CDR A) (CDR B))))))
(RETURN NIL)))
(MIDPR A B)
(MIDPR B C)
(SETQ X (FIX (PLUS 10 (TIMES DX (CAR B)))))
(SETQ Y (FIX (ABS (DIFFERENCE (TIMES DY (CDR B)) (PLUS YMAXDY 5)))))
(COND
((AND (GREATERP 66 Y) (GREATERP 160 X) (GREATERP Y -1) (GREATERP X -1))
(NSTORE (PAGE Y X) (COND (KIND 14) (T 16)))))))
EXPR)
(DEFPROP LSPR
(LAMBDA(Z)
(COND ((ATOM (CAR Z))
(PROG (TEM Y)
(SETQ TEM ORG)
(SETQ Y (COND ((SETQ PEN (ATOM (CDR Z))) (CDR Z)) (T (CADR Z))))
(SETQ ORG (CONS (PLUS (CAR Z) (CAR ORG)) (PLUS (CDR ORG) Y)))
(COND (PEN (MIDPR TEM ORG)))
(RETURN ORG)))
(T (PROG2 (LSPR (LIST (CAAR Z) (CDAR Z))) (LSPR (CDR Z))))))
EXPR)
(DEFPROP PRCHAR
(LAMBDA(Z)
(PROG (X Y)
(SETQ X (FIX (PLUS 10 (TIMES DX (CAR ORG)))))
(SETQ Y (FIX (ABS (DIFFERENCE (TIMES DY (CDR ORG)) (PLUS YMAXDY 5)))))
(PRCHAR2 X Y Z)
(RETURN ORG)))
EXPR)
(DEFPROP PRCHAR2
(LAMBDA(X Y Z)
(COND ((NULL Z) NIL)
(T
(PROG2 (COND ((EQ (CAR Z) (QUOTE P)) (NSTORE (PAGE Y X) 13))
((EQ (CAR Z) (QUOTE K)) (NSTORE (PAGE Y X) 15))
((EQ (CAR Z) (QUOTE N)) (NSTORE (PAGE Y X) 12))
((NUMBERP (CAR Z)) (NSTORE (PAGE Y X) (CAR Z)))
(T NIL))
(PRCHAR2 (ADD1 X) Y (CDR Z))))))
EXPR)
(DEFPROP CAF
(LAMBDA NIL
(PROG (I J)
(SETQ I 65)
L2 (SETQ J 157)
L1 (NSTORE (PAGE I J) 0)
(COND ((GREATERP (SETQ J (SUB1 J)) -1) (GO L1)) ((GREATERP (SETQ I (SUB1 I)) -1) (GO L2)))
(SETQ I 65)
L3 (NSTORE (PAGE I 0) 17)
(NSTORE (PAGE I 157) 17)
(COND ((GREATERP (SETQ I (SUB1 I)) -1) (GO L3)))
(SETQ J 157)
L4 (NSTORE (PAGE 0 J) 17)
(NSTORE (PAGE 65 J) 17)
(COND ((GREATERP (SETQ J (SUB1 J)) -1) (GO L4)) (T (RETURN NIL)))))
EXPR)
(DEFPROP DXDY
(LAMBDA NIL
(CONS (SETQ DY (QUOTIENT 44.0 (TIMES 300 (PLUS (MINUS YMIN) YMAX))))
(PROG2 (SETQ YMAXDY (TIMES YMAX 300 DY)) (SETQ DX (QUOTIENT 96.0 (TIMES 300 XMAX))))))
EXPR)
(DEFPROP YBULGE
(LAMBDA(Z)
(COND ((NULL Z) NIL)
(T
(PROG (PPP LEVEL)
(COND ((ZEROP (SETQ LEVEL (CDR (EVAL (CAR Z))))) (GO L2)))
(SETQ PPP (MIDPOINT (EVAL (CAAR (EVAL (CAR Z)))) (EVAL (CDAR (EVAL (CAR Z))))))
(COND ((AND (EQ (CDR PPP) (TIMES YMIN 300)) (MINUSP LEVEL)) (SETQ YMIN (PLUS YMIN -0.5)))
((AND (EQ (CDR PPP) (TIMES YMAX 300)) (NOT (MINUSP LEVEL))) (SETQ YMAX (PLUS YMAX 0.5))))
L2 (YBULGE (CDR Z))))))
EXPR)
(DEFPROP SOF
(LAMBDA NIL (PROG NIL (SETQ SA BPORG) (ARRAY PAGE 4 66 160) (SETQ FA BPORG)))
EXPR)
(DEFPROP IMAGE
(LAMBDA NIL
(PROG NIL
(SETQ L -1)
(OUTC (OUTPUT LPT:) T)
(LINELENGTH 160)
L3 (SETQ N 0)
(COND ((GREATERP (SETQ L (ADD1 L)) 65) (RETURN (OUTC NIL T))))
L2 (SETQ CHAR (PAGE L N))
(COND ((EQ 0 CHAR) (TYO 40))
((EQ 14 CHAR) (TYO 56))
((LESSP CHAR 12) (TYO (PLUS CHAR 60)))
((EQ 13 CHAR) (TYO 120))
((EQ 15 CHAR) (TYO 113))
((EQ 16 CHAR) (TYO 52))
((EQ 17 CHAR) (TYO 45))
((EQ 12 CHAR) (TYO 26)))
(COND ((GREATERP (SETQ N (ADD1 N)) 157) (PROG2 (TERPRI) (GO L3))) (T (GO L2)))))
EXPR)
(DEFPROP PFEY
(LAMBDA(Z)
(PROG (IPL OPL MPL EPL INL ONL MNL ENL YMAX YMIN XMAX)
(SETQ YMAX (SETQ YMIN (SETQ XMAX 0)))
(FEYNMAN Z)
(MAPC (FUNCTION ADJUST) ENL)
(OVERLAP EPL)
(CAF)
(YBULGE EPL)
(DXDY)
(SETQ ORG (QUOTE (0 . 0)))
(OUTPART (FUNCTION LSPR) EPL)
(OUTNODE ENL)
(IMAGE)))
EXPR)
(DEFPROP FEYNMAN
(LAMBDA(Z)
(PROG (NOL)
(CSYM G0000)
(MAPC (FUNCTION NILVAL) (APPEND (CAAR (FUSE Z)) (CDAR (FUSE Z))))
(SETQ MNL (NSET Z))
(SETQ EPL (IOBOTH (FUSE Z)))
(SETQ IPL (CAAR EPL))
(SETQ OPL (CDAR EPL))
(SETQ MPL (CDR EPL))
(SETQ EPL (APPEND IPL OPL MPL))
(SETQ INL (NSET (MAPCAR (FUNCTION (LAMBDA (Z) (LIST NIL Z))) IPL)))
(SETQ ONL (NSET (MAPCAR (FUNCTION (LAMBDA (Z) (LIST (LIST Z)))) OPL)))
(SETQ ENL (APPEND INL MNL ONL))
(MAPC (FUNCTION KING) ENL)
(XPLY 0 INL NIL)
(SETQ NOL ENL)
YLOOP
(YSET (CAR NOL) YMIN)
(SETQ NOL (YMISS ENL))
(YMINAX (SUBSET ENL NOL))
(COND ((NOT (NULL NOL)) (GO YLOOP)))
(XSET ONL XMAX)
(RETURN NIL)))
EXPR)
(DEFPROP OVERLAP
(LAMBDA(Z)
(COND ((NULL Z) NIL)
((AND (NOT (MEMBER (EVAL (CAR Z)) (MAPCAR (FUNCTION EVAL) (CDR Z))))
(NOT (MEMBER (CONS (CDR (EVAL (CAR Z))) (CAR (EVAL (CAR Z)))) (MAPCAR (FUNCTION EVAL) (CDR Z)))))
(PROG2 (SET (CAR Z) (CONS (EVAL (CAR Z)) 0)) (OVERLAP (CDR Z))))
(T
(PROG (IDPL)
(SETQ IDPL (EQVAL (EVAL (CAR Z)) Z))
(SETLEVEL 0 (PHUNT IDPL IDPL))
(OVERLAP (SUBSET Z IDPL))))))
EXPR)
(DEFPROP EQVAL
(LAMBDA(A Z)
(COND ((NULL Z) NIL)
((OR (EQUAL A (CONS (CDR (EVAL (CAR Z))) (CAR (EVAL (CAR Z))))) (EQUAL A (EVAL (CAR Z))))
(CONS (CAR Z) (EQVAL A (CDR Z))))
(T (EQVAL A (CDR Z)))))
EXPR)
(DEFPROP PHUNT
(LAMBDA(Z1 Z2)
(COND ((NULL Z2) Z1)
((EQ (QUOTE P) (CAR (EXPLODE (CAR Z2)))) (CONS (CAR Z2) (DELETE (CAR Z2) Z1)))
(T (PHUNT Z1 (CDR Z2)))))
EXPR)
(DEFPROP SETLEVEL
(LAMBDA(N Z)
(COND ((NULL Z) NIL)
(T
(PROG2 (SET (CAR Z) (CONS (EVAL (CAR Z)) N))
(SETLEVEL (COND ((ZEROP N) 1) ((MINUSP N) (MINUS (SUB1 N))) (T (MINUS N))) (CDR Z))))))
EXPR)
(DEFPROP OUTPART
(LAMBDA(LS Z)
(COND ((NULL Z) NIL)
(T
(PROG (PPP1 PPP2 LEVEL MIDP CC SS LL L2 KIND)
(SETQ LEVEL (CDR (EVAL (CAR Z))))
(SETQ PPP1 (EVAL (CAAR (EVAL (CAR Z)))))
(SETQ PPP2 (EVAL (CDAR (EVAL (CAR Z)))))
(SETQ KIND (EQ (QUOTE P) (CAR (EXPLODE (CAR Z)))))
(COND ((EQUAL PPP1 PPP2) (PROG2 (SETQ LEVEL 1) (FERMI3) (RETURN (OUTPART LS (CDR Z))))))
(SETQ MIDP (MIDPOINT PPP1 PPP2))
(LS (LXY (VSUB PPP1 (SIZORG))))
(SETQ L2 (METRIC PPP1 PPP2))
(SETQ LL (ROOT L2))
(SETQ SS (QUOTIENT (DIFFERENCE (CDR PPP2) (CDR PPP1)) LL))
(SETQ CC (QUOTIENT (DIFFERENCE (CAR PPP2) (CAR PPP1)) LL))
(COND ((ZEROP LEVEL) (FERMI1)) (T (FERMI2)))
(OUTPART LS (CDR Z))))))
EXPR)
(DEFPROP TAGEL
(LAMBDA(S C LS CHARS)
(LS (LXY (VSUBSIZ ORG (PROG2 (LS (LXY (VADD (ROTATE (TORG) S C) (TORG2)))) (PRCHAR CHARS))))))
EXPR)
(DEFPROP TORG
(LAMBDA NIL
(CONS
(COND
((OR (MINUSP C) (AND (OR (GREATERP C S) (EQ C S)) (GREATERP S (MINUS C))) (AND (ZEROP C) (MINUSP S))) -6)
(T 6))
(COND
((OR (AND (MINUSP S) (GREATERP C S)) (AND (NOT (MINUSP S)) (GREATERP (MINUS C) S)) (ZEROP S)) 11)
(T -11))))
EXPR)
(DEFPROP TORG2
(LAMBDA NIL
(CONS
(COND
((OR (AND (GREATERP S C) (GREATERP (MINUS C) S)) (AND (EQUAL S C) (MINUSP S))) (TIMES -14 (LENGTH CHARS)))
(T 0))
(COND
((OR (AND (GREATERP C 0) (GREATERP S 0))
(AND (GREATERP C S) (MINUSP C))
(AND (GREATERP (MINUS C) S) (NOT (MINUSP S)))
(ZEROP C))
-14)
(T 0))))
EXPR)
(DEFPROP ARROW
(LAMBDA(S C LS)
(PROG (PSORG)
(SETQ PSORG ORG)
(LS (ROTATE (QUOTE (-25 . 25)) S C))
(LS (ROTATE (QUOTE (17 . -25)) S C))
(LS (ROTATE (QUOTE (-17 . -25)) S C))
(LS
(CONS (QUOTIENT (DIFFERENCE (CAR PSORG) (CAR ORG)) SIZ)
(QUOTIENT (DIFFERENCE (CDR PSORG) (CDR ORG)) SIZ)))))
EXPR)
(DEFPROP FERMI1
(LAMBDA NIL
(PROG NIL (LS (VSUB MIDP PPP1)) (ARROW SS CC LS) (TAGEL SS CC LS (EXPLODE (CAR Z))) (LS (VSUB PPP2 MIDP))))
EXPR)
(DEFPROP FERMI2
(LAMBDA NIL
(PROG (PSORG LLX)
(SETQ PSORG (QUOTE (0 . 0)))
(SETQ LLX (QUOTIENT (ROOT (METRIC PPP2 PPP1)) 8.0))
(JIGJAG 1 (QUOTE (36 52 60 60)))
(ARROW SS CC LS)
(TAGEL SS CC LS (EXPLODE (CAR Z)))
(JIGJAG 5 (QUOTE (60 52 36)))
(LS (VSUB PPP2 (SIZORG)))))
EXPR)
(DEFPROP FERMI3
(LAMBDA NIL
(PROG (PSORG LLX PHASE ACTEND)
(COND ((OR (GET (CAR Z) (QUOTE NTO)) (GET (CAR Z) (QUOTE NFROM))) (MAPC LS NODE)))
(SETQ PSORG (SETQ ACTEND (QUOTE (0 . 0))))
(SETQ PHASE 0)
(SETQ LLX (TIMES SIZ -30))
(SETQ SS 0.0)
(SETQ CC 1.0)
(JIGJAG 1 (QUOTE (11 36)))
(SETQ LLX (MINUS LLX))
(JIGJAG -1 (QUOTE (60 60)))
(ARROW SS CC LS)
(TAGEL SS CC LS (EXPLODE (CAR Z)))
(JIGJAG 0 (QUOTE (60 60 36)))
(SETQ LLX (MINUS LLX))
(JIGJAG -1 (QUOTE (11)))
(JIGJAG 0 (QUOTE (0)))))
EXPR)
(DEFPROP JIGJAG
(LAMBDA(N Z)
(COND ((NULL Z) NIL)
(T
(PROG (PTEMP)
(SETQ PTEMP (ROTATE (CONS (TIMES N LLX) (TIMES LEVEL (CAR Z))) SS CC))
(LS (VSUB PTEMP PSORG))
(SETQ PSORG PTEMP)
(JIGJAG (ADD1 N) (CDR Z))))))
EXPR)
(DEFPROP NSET
(LAMBDA(Z)
(COND ((NULL Z) NIL)
(T
(CONS (PROG (TEMP)
(SET (SETQ TEMP (INTERN (GENSYM))) (CAR Z))
(TFSET (CAAR Z) (FUNCTION CONS))
(TFSET (CDAR Z) (FUNCTION XCONS))
(RETURN TEMP))
(NSET (CDR Z))))))
EXPR)
(DEFPROP TFSET
(LAMBDA(Z FCONS)
(MAPC (FUNCTION
(LAMBDA(X)
(SET X
(COND ((NULL (EVAL X)) (FCONS NIL TEMP))
(T (FCONS (CAR (FCONS (CAR (EVAL X)) (CDR (EVAL X)))) TEMP))))))
Z))
EXPR)
(DEFPROP NILVAL
(LAMBDA (Z) (SET Z NIL))
EXPR)
(DEFPROP FUSE
(LAMBDA(Z)
(COND ((NULL Z) NIL)
((NULL (CDR Z)) Z)
(T (FUSE (CONS (CONS (APPEND (CAAR Z) (CAADR Z)) (APPEND (CDAR Z) (CDADR Z))) (CDDR Z))))))
EXPR)
(DEFPROP IOBOTH
(LAMBDA(Z)
(COND ((NULL (CAAR Z)) Z)
((NULL (CDAR Z)) Z)
((MEMBER (CAAAR Z) (CDAR Z))
(IOBOTH
(CONS (CONS (DELETE (CAAAR Z) (CDAAR Z)) (DELETE (CAAAR Z) (CDAR Z))) (CONS (CAAAR Z) (CDR Z)))))
(T (INSERT (CAAAR Z) (IOBOTH (CONS (CONS (DELETE (CAAAR Z) (CDAAR Z)) (CDAR Z)) (CDR Z)))))))
EXPR)
(DEFPROP DELETE
(LAMBDA(A Z)
(COND ((NULL Z) NIL) (T (APPEND (COND ((EQ A (CAR Z)) NIL) (T (NCONS (CAR Z)))) (DELETE A (CDR Z))))))
EXPR)
(DEFPROP INSERT
(LAMBDA (A Z) (CONS (CONS (CONS A (CAAR Z)) (CDAR Z)) (CDR Z)))
EXPR)
(DEFPROP UNIQUE
(LAMBDA (Z) (COND ((NULL Z) NIL) (T (CONS (CAR Z) (DELETE (CAR Z) (UNIQUE (CDR Z)))))))
EXPR)
(DEFPROP UNBUCK
(LAMBDA (Z) (COND ((NULL Z) NIL) (T (APPEND (CAR Z) (UNBUCK (CDR Z))))))
EXPR)
(DEFPROP SUBSET
(LAMBDA (A B) (COND ((NULL B) A) (T (SUBSET (DELETE (CAR B) A) (CDR B)))))
EXPR)
(DEFPROP INTERSECTION
(LAMBDA(A B)
(COND ((OR (NULL A) (NULL B)) NIL)
(T (APPEND (COND ((MEMQ (CAR A) B) (NCONS (CAR A))) (T NIL)) (INTERSECTION (CDR A) B)))))
EXPR)
(DEFPROP PEN
(NIL . T)
VALUE)
(DEFPROP PEN
T
SPECIAL)
(DEFPROP ORG
(NIL 1400 . -300)
VALUE)
(DEFPROP ORG
T
SPECIAL)
(DEFPROP SIZORG
(LAMBDA NIL (CONS (QUOTIENT (CAR ORG) SIZ) (QUOTIENT (CDR ORG) SIZ)))
EXPR)
(DEFPROP SIZ
(NIL . 1)
VALUE)
(DEFPROP KING
(LAMBDA(Z)
(PUTPROP Z
(UNIQUE
(APPEND (MAPCAR (FUNCTION CAR) (MAPCAR (FUNCTION EVAL) (CAR (EVAL Z))))
(MAPCAR (FUNCTION CDR) (MAPCAR (FUNCTION EVAL) (CDR (EVAL Z))))))
(QUOTE NEAR)))
EXPR)
(DEFPROP GETNEAR
(LAMBDA (Z) (GET Z (QUOTE NEAR)))
EXPR)
(DEFPROP OUTNODE
(LAMBDA(Z)
(COND ((NULL Z) NIL) (T (PROG2 (SETQ ORG (EVAL (CAR Z))) (PRCHAR (QUOTE (N))) (OUTNODE (CDR Z))))))
EXPR)
(DEFPROP XPLY
(LAMBDA(N Z AC)
(COND ((ALIKE AC ENL) NIL)
((NULL Z) (XPLY 0 (NCONS (CAR (SUBSET ENL AC))) AC))
(T
(PROG2 (SETQ XMAX (COND ((GREATERP (SETQ NNN N) XMAX) N) (T XMAX)))
(MAPC (FUNCTION SETN) Z)
(XPLY (ADD1 N)
(SUBSET (UNIQUE (UNBUCK (MAPCAR (FUNCTION GETNEAR) Z))) (APPEND AC Z))
(APPEND AC Z))))))
EXPR)
(DEFPROP ALIKE
(LAMBDA(A B)
(COND ((NULL A) (COND ((NULL B) T) (T NIL))) ((NULL B) NIL) (T (ALIKE (CDR A) (DELETE (CAR A) B)))))
EXPR)
(DEFPROP SETN
(LAMBDA (Z) (SET Z NNN))
EXPR)
(DEFPROP XSET
(LAMBDA (Z N) (COND ((NULL Z) NIL) (T (PROG2 (SET (CAR Z) (CONS N (CDR (EVAL (CAR Z))))) (XSET (CDR Z) N)))))
EXPR)
(DEFPROP YSET
(LAMBDA(NOD Y)
(PROG (TEMP)
L1 (SETQ TEMP (CONS (EVAL NOD) Y))
(COND ((OAOOP TEMP ENL) (GO L2)))
(SETQ TEMP (CONS (EVAL NOD) (SUB1 Y)))
(COND ((OAOOP TEMP ENL) (GO L2)))
(SETQ TEMP (CONS (EVAL NOD) (ADD1 Y)))
(COND ((OAOOP TEMP ENL) (GO L2)))
(MOVE ENL Y)
(GO L1)
L2 (SET NOD TEMP)
(YSET2 (GETNEAR NOD) NOD)
(RETURN NIL)))
EXPR)
(DEFPROP YSET2
(LAMBDA(Z NOD)
(COND ((NULL Z) NIL)
(T
(PROG (TEM)
(COND ((NOT (NUMBERP (SETQ TEM (EVAL (CAR Z))))) (GO LL)))
(COND
((EQUAL TEM (CAR (EVAL NOD)))
(COND
((AND (NOT (OAOOP (CONS TEM (SUB1 (CDR (EVAL NOD)))) ENL))
(OAOOP (CONS TEM (ADD1 (CDR (EVAL NOD)))) ENL))
(YSET (CAR Z) (ADD1 (CDR (EVAL NOD)))))
(T (YSET (CAR Z) (SUB1 (CDR (EVAL NOD)))))))
(T (YSET (CAR Z) (CDR (EVAL NOD)))))
LL (YSET2 (CDR Z) NOD)
(RETURN NIL)))))
EXPR)
(DEFPROP OAOOP
(LAMBDA (N Z) (COND ((NULL Z) T) ((EQUAL N (EVAL (CAR Z))) NIL) (T (OAOOP N (CDR Z)))))
EXPR)
(DEFPROP MOVE
(LAMBDA(Z Y)
(COND ((NULL Z) NIL)
(T
(PROG2 (COND ((ATOM (EVAL (CAR Z))) NIL)
((GREATERP Y (CDR (EVAL (CAR Z)))) NIL)
(T (SET (CAR Z) (CONS (CAR (EVAL (CAR Z))) (ADD1 (CDR (EVAL (CAR Z))))))))
(MOVE (CDR Z) Y)))))
EXPR)
(DEFPROP YMINAX
(LAMBDA(Z)
(COND ((NULL Z) NIL)
(T
(PROG (Y)
(SETQ Y (CDR (EVAL (CAR Z))))
(COND ((GREATERP Y YMAX) (SETQ YMAX Y)))
(COND ((LESSP Y YMIN) (SETQ YMIN Y)))
(YMINAX (CDR Z))))))
EXPR)
(DEFPROP YMISS
(LAMBDA(Z)
(COND ((NULL Z) NIL) ((NUMBERP (EVAL (CAR Z))) (CONS (CAR Z) (YMISS (CDR Z)))) (T (YMISS (CDR Z)))))
EXPR)
(DEFPROP YMAX
(NIL . 0)
VALUE)
(DEFPROP YMAX
T
SPECIAL)
(DEFPROP XMAX
(NIL . 4)
VALUE)
(DEFPROP XMAX
T
SPECIAL)
(DEFPROP YMIN
(NIL . -1)
VALUE)
(DEFPROP YMIN
T
SPECIAL)
(DEFPROP F1
(NIL ((P2) P1 K1) ((P4) P3 K2) ((P6 K2 K1) P5))
VALUE)
(DEFPROP F2
(NIL ((P1 P4) K1 K2 P2) ((K1 P3) P4 P5) ((K2 P2) P3 P6))
VALUE)
(DEFPROP VADD
(LAMBDA (P1 P2) (CONS (PLUS (CAR P1) (CAR P2)) (PLUS (CDR P2) (CDR P1))))
EXPR)
(DEFPROP VSUB
(LAMBDA (P2 P3) (CONS (DIFFERENCE (CAR P2) (CAR P3)) (DIFFERENCE (CDR P2) (CDR P3))))
EXPR)
(DEFPROP VSUBSIZ
(LAMBDA (A B) (CONS (QUOTIENT (DIFFERENCE (CAR A) (CAR B)) SIZ) (QUOTIENT (DIFFERENCE (CDR A) (CDR B)) SIZ)))
EXPR)
(DEFPROP LXY
(LAMBDA (Z) (CONS (CAR Z) (NCONS (CDR Z))))
EXPR)
(DEFPROP SLOPE
(LAMBDA (P1 P2) (QUOTIENT (DIFFERENCE (CDR P2) (CDR P1) P 0.0) (DIFFERENCE (CAR P2) (CAR P1))))
EXPR)
(DEFPROP MIDPOINT
(LAMBDA (Z1 Z2) (CONS (QUOTIENT (PLUS (CAR Z1) (CAR Z2)) 2) (QUOTIENT (PLUS (CDR Z1) (CDR Z2)) 2)))
EXPR)
(DEFPROP METRIC
(LAMBDA (P1 P2) (PLUS (SQUARE (DIFFERENCE (CAR P1) (CAR P2))) (SQUARE (DIFFERENCE (CDR P1) (CDR P2)))))
EXPR)
(DEFPROP SQUARE
(LAMBDA (N) (TIMES N N))
EXPR)
(DEFPROP INCREM
(LAMBDA(P D)
(PROG (TEM)
(RETURN
(CONS (SETQ TEM (PLUS (CAR P) (ALSH (CDR P) (MINUS D)))) (DIFFERENCE (CDR P) (ALSH TEM (MINUS D)))))))
EXPR)
(DEFPROP CARLAST
(LAMBDA (Z) (CAR (LAST Z)))
EXPR)
(DEFPROP ALSH
(LAMBDA (Z N) (COND ((MINUSP Z) (MINUS (LSH (ABS Z) N))) (T (LSH Z N))))
EXPR)
(DEFPROP ADJUST
(LAMBDA (Z) (SET Z (CONS (TIMES (CAR (EVAL Z)) 300) (TIMES (CDR (EVAL Z)) 300))))
EXPR)
(DEFPROP ROTATE
(LAMBDA(P SIN COS)
(CONS (FIX (DIFFERENCE (TIMES COS (PLUS 0.0 (CAR P))) (TIMES SIN (PLUS 0.0 (CDR P)))))
(FIX (PLUS (TIMES COS (PLUS 0.0 (CDR P))) (TIMES SIN (PLUS 0.0 (CAR P)))))))
EXPR)
(DEFPROP ROOT
(LAMBDA (A) (NEWTON 14 (PLUS A 0.0) (QUOTIENT (PLUS A 0.0) 2.0)))
EXPR)
(DEFPROP NEWTON
(LAMBDA (N A X) (COND ((ZEROP N) X) (T (NEWTON (SUB1 N) A (QUOTIENT (PLUS X (QUOTIENT A X)) 2.0)))))
EXPR)
(DEFPROP TESTS
(NIL TP1 TP2 TP3 TP4 TP5 TP6 TP7 TP8 TP9 TP10 TP11 TP12 TP13 TP14 TP15 TP16 TP17 TP18 TP19 TP20 TP20 TP22)
VALUE)
(DEFPROP TP1
(NIL ((P2) P1 K1) ((P4) P3 K2) ((P6 K2 K1) P5))
VALUE)
(DEFPROP TP2
(NIL ((P2) P1 K1) ((P4 K1) P3 K2) ((P6 K2) P5))
VALUE)
(DEFPROP TP3
(NIL ((K2) P2 P1) ((P4) P3 K1) ((K1 P1) P5))
VALUE)
(DEFPROP TP4
(NIL ((K2) P2 P1) ((P4) P3 K1) ((P5 K1 P1)))
VALUE)
(DEFPROP TP5
(NIL ((K2) P2 P1) ((P1) P3 K1) ((P5 K1) P4))
VALUE)
(DEFPROP TP6
(NIL ((K2) P2 P1) ((P3 P1) K1) ((P5 K1) P4))
VALUE)
(DEFPROP TP7
(NIL ((K2 P2) P1) ((P4) P3 K1) ((P5 K1 P1)))
VALUE)
(DEFPROP TP8
(NIL ((K2 P2) P1) ((P3 P1) K1) ((P5 K1) P4))
VALUE)
(DEFPROP TP9
(NIL ((P3) P2 K1) (NIL P4 K2 P1) ((K2 P1 K1) P5))
VALUE)
(DEFPROP TP10
(NIL ((P3) P2 K1) ((K1) P4 K2 P1) ((K2 P1) P5))
VALUE)
(DEFPROP TP11
(NIL ((K2) P3 P1) (NIL P4 K1 P2) ((K1 P2 P1) P5))
VALUE)
(DEFPROP TP12
(NIL ((K2) P3 P1) (NIL P4 K1 P2) ((K1 P2 P1)))
VALUE)
(DEFPROP TP13
(NIL ((K2) P3 P1) ((P1) P4 K1 P2) ((K1 P2) P5))
VALUE)
(DEFPROP TP14
(NIL ((K2) P3 P1) ((P1) K1 P2) ((K1 P2) P4))
VALUE)
(DEFPROP TP15
(NIL ((K2 P3) P1) (NIL P4 K1 P2) ((K1 P2 P1)))
VALUE)
(DEFPROP TP16
(NIL ((K2 P3) P1) ((P1) K1 P2) ((K1 P2) P4))
VALUE)
(DEFPROP TP17
(NIL ((P4) P3 K1) (NIL P5 K2 P2 P1) ((K2 P2 P1 K1)))
VALUE)
(DEFPROP TP18
(NIL ((P4) P3 K1) ((K1) P5 K2 P2 P1) ((K2 P2 P1)))
VALUE)
(DEFPROP TP19
(NIL ((K2) P4 P1) (NIL P5 K1 P3 P2) ((K1 P3 P2 P1)))
VALUE)
(DEFPROP TP20
(NIL ((K2) P4 P1) (NIL P5 K1 P3 P2) ((K1 P3 P2 P1)))
VALUE)
(DEFPROP TP20
(NIL ((K2) P4 P1) (NIL P5 K1 P3 P2) ((K1 P3 P2 P1)))
VALUE)
(DEFPROP TP22
(NIL ((K2 P4) P1) (NIL P5 K1 P3 P2) ((K1 P3 P2 P1)))
VALUE)
(DEFPROP OFF
(LAMBDA NIL (OUTC NIL T))
EXPR)